home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-06 / segue.exe / SS_FILER.PRG < prev    next >
Text File  |  1991-05-20  |  12KB  |  519 lines
  1. *----------------------
  2. * Function............FILEREAD()
  3. * Action..............Lists a text file of unlimited size
  4. * Returns.............nothing
  5. * Category............Superfunction
  6. * Syntax..............FILEREAD([expN1],[expN2],[expN3],[expN4],[expC])
  7. * Description.........Lists text file [expC] of unlimited size in a user
  8. *                     definable window. [expN1..expN4].
  9. *                     Allows up down right left scrolling. Use this
  10. *                     for reports or output sent to a disk file.
  11. * Options.............If [expN1..expN4] are not passed, a default of
  12. *                     window of dimensions 2,2,22,78 is used. If no
  13. *                     filename [expC] is passed, a popup picklist is
  14. *                     used to get a file name from the current
  15. *                     directory.
  16. * Examples............REPORT FORM summary TO summary.txt
  17. *                     FILEREAD(2,2,22,78,"SUMMARY.TXT")
  18. * Notes...............Unlimited file size. Won't bomb like memoedit.
  19. *                     However, not nearly as fast as memoedit and
  20. *                     no editing capabilities.
  21. *
  22. *                     Fileread uses a 98% Clipper code routine to
  23. *                     list text files.
  24. *
  25. *                     Inspired by Mike Taylors DISPLAY() function
  26. *                     written in C/ASM and in the Public Domain
  27. *
  28. * Warnings............Leaves cursor set ON
  29. *----------------------
  30. FUNCTION Fileread
  31.  
  32.  
  33. PARAM boxtop,boxleft,boxbot,boxright,filename
  34.  
  35. PRIVATE handle,topline,botline,leftedge,rightedge,linelength
  36. PRIVATE nbrlines,lineoffset,kounter,endof_file
  37. PRIVATE last_key,standard,position
  38.  
  39.  
  40. *initsup()
  41.  
  42.  
  43. *- were all params passed
  44. *- if filename not passed, get one
  45. IF Pcount() < 5
  46.   filename = SPACE(12)
  47.   one_read("File to list (ENTER or *Wildcards for picklist - ESC to exit)","filename","")
  48.   IF LASTKEY() = 27
  49.     RETURN .F.
  50.   ENDIF
  51.   IF EMPTY(m->filename) .OR. AT('*',m->filename) > 0
  52.     IF EMPTY(m->filename)
  53.       filename = "*.*"
  54.     ENDIF
  55.     filename = popex(m->filename)
  56.   ENDIF
  57.   IF LASTKEY() = 27
  58.     RETURN .F.
  59.   ENDIF
  60. ENDIF
  61.  
  62. *- assign box dimensions if need be
  63. IF Pcount() < 4
  64.   boxtop = 2
  65.   boxleft= 2
  66.   boxbot = 22
  67.   boxright = 78
  68. ENDIF
  69.  
  70.  
  71. *- check for file's existence
  72. IF !FILE(m->filename)
  73.   RETURN .F.
  74. ENDIF
  75.  
  76. *- open the file, check for errors
  77. handle = FOPEN(m->filename,0)
  78. IF Ferror() <> 0
  79.   msg("Error opening file : "+m->filename)
  80.   RETURN ''
  81. ENDIF
  82.  
  83. *- not at the end of file
  84. endof_file = .F.
  85.  
  86. *- set cursor off
  87. SET CURSOR OFF
  88.  
  89.  
  90. *- draw screen
  91. PRIVATE r_file
  92. r_file=makebox(m->boxtop,m->boxleft,m->boxbot,m->boxright,m->c_popcol,0,0)
  93. @m->boxbot-2,m->boxleft TO m->boxbot-2,m->boxright
  94. @m->boxbot-2,m->boxleft SAY CHR(195)
  95. @m->boxbot-2,m->boxright SAY CHR(180)
  96. @m->boxtop,m->boxleft+2 SAY '['+UPPER(m->filename)+']'
  97. @m->boxbot-1,m->boxleft+2 SAY'['+CHR(24)+CHR(25)+CHR(26)+CHR(27)+' PGUP PGDN HOME END] [ESC to quit]'
  98. *-
  99.  
  100. *- initialize dimensions for screen output of file
  101. topline   = m->boxtop+1
  102. botline   = m->boxbot-3
  103. leftedge  = m->boxleft+1
  104. rightedge = m->boxright-1
  105.  
  106. *- get line length, number of lines in box, and starting line offset
  107. linelength   = m->boxright-m->boxleft-1
  108. nbrlines  = m->boxbot-m->boxtop-3
  109. lineoffset = 1
  110.  
  111.  
  112. *- store standard color to a variable
  113. standard = standard()
  114.  
  115. *- initialize two arrays - one for the current set of lines, and one for
  116. *- the file offset of each line
  117. PRIVATE Lines[m->nbrlines],Offset[m->nbrlines]
  118.  
  119.  
  120. *- draw the first set of lines , storing the values in the above two
  121. *- arrays
  122. rf_sayall()
  123.  
  124.  
  125.  
  126. DO WHILE .T.
  127.   
  128.   *- wait for a key
  129.   INKEY(0)
  130.   last_key = LASTKEY()
  131.   
  132.   
  133.   DO CASE
  134.   CASE m->last_key = 5 .AND. Offset[1] > 0
  135.     
  136.     *- go to offset of first line
  137.     position = Offset[1]
  138.     FSEEK(m->handle,m->position)
  139.     
  140.     *- move up one line
  141.     rf_scrlup()
  142.     
  143.     *- we're not at the end of file
  144.     endof_file = .F.
  145.     
  146.     
  147.   CASE m->last_key = 24 .AND. !m->endof_file
  148.     
  149.     *- move down one line
  150.     rf_scrldn(1)
  151.     
  152.     
  153.   CASE m->last_key = 18
  154.     
  155.     *- go to offset of first line
  156.     FSEEK(m->handle,Offset[1])
  157.     
  158.     *- move up one full page of lines
  159.     kounter = 1
  160.     FOR m->kounter = 1 TO m->nbrlines
  161.       fgobak()
  162.     NEXT
  163.     
  164.     *- now paint the current set of lines, filling in the arrays
  165.     rf_sayall()
  166.     
  167.     *- not at end of file
  168.     endof_file = .F.
  169.     
  170.   CASE m->last_key = 3 .AND. !m->endof_file
  171.     
  172.     *- move down one full page of lines
  173.     rf_scrldn(m->nbrlines)
  174.     
  175.     
  176.   CASE m->last_key = 1
  177.     
  178.     *- not at end of file
  179.     endof_file = .F.
  180.     
  181.     *- go to beginning if file
  182.     ftop(m->handle)
  183.     
  184.     *- now paint the current set of lines, filling in the arrays
  185.     rf_sayall()
  186.     
  187.   CASE m->last_key = 6 .AND. !m->endof_file
  188.     
  189.     *- go to the end of the file
  190.     fbot(m->handle)
  191.     
  192.     *- move back one full screen of lines
  193.     kounter = 1
  194.     FOR m->kounter = 1 TO m->nbrlines
  195.       fgobak()
  196.     NEXT
  197.     
  198.     
  199.     *- now paint the current set of lines, filling in the arrays
  200.     rf_sayall()
  201.     
  202.     *- we are at the end of file
  203.     endof_file = .T.
  204.     
  205.   CASE m->last_key = 27
  206.     
  207.     *- close the file and exit the loop
  208.     Fclose(m->handle)
  209.     EXIT
  210.     
  211.     
  212.   CASE m->last_key = 4
  213.     
  214.     *- if the longest element of the current lines[] array is longer
  215.     *- than the linelength of the box, move the line offset over 5
  216.     *- places
  217.     IF bigelem(m->lines) >= (m->lineoffset+m->linelength)
  218.       lineoffset = m->lineoffset+5
  219.       rf_resay()
  220.     ENDIF
  221.     
  222.     
  223.   CASE m->last_key = 19
  224.     IF m->lineoffset > 1
  225.       lineoffset = MAX(m->lineoffset-5,1)
  226.       
  227.       *- just redraw the lines starting at the new line offset
  228.       rf_resay()
  229.     ENDIF
  230.     
  231.     
  232.   ENDCASE
  233.   
  234.   
  235. ENDDO
  236.  
  237. *- set cursor on
  238. SET CURSOR ON
  239.  
  240.  
  241. unbox(m->r_file)
  242. RETURN ''
  243.  
  244.  
  245.  
  246.  
  247.  
  248. FUNCTION rf_sayall
  249.  
  250. PRIVATE kounter
  251.  
  252. *- fill the arrays with .f.
  253. Afill(m->lines,.F.)
  254. Afill(m->offset,.F.)
  255.  
  256. *- clear the window
  257. Scroll(m->topline,m->leftedge,m->botline,m->rightedge,0)
  258.  
  259. *- for # of lines allowed in box
  260. kounter = 1
  261. FOR m->kounter = 1 TO m->nbrlines
  262.   
  263.   *- get current offset into array element
  264.   Offset[m->kounter] = FSEEK(m->handle,0,1)
  265.   
  266.   *- get current line contents into array element
  267.   Lines[m->kounter] = fgetline(m->handle)+SPACE(10)
  268.   
  269.   *- display the line within the box
  270.   prnt(m->boxtop+m->kounter,m->leftedge,SUBST(Lines[m->kounter],m->lineoffset,m->linelength),m->standard)
  271.   
  272. NEXT
  273.  
  274. RETURN ''
  275.  
  276.  
  277.  
  278. FUNCTION rf_resay
  279.  
  280. PRIVATE kounter
  281.  
  282. *- clear the box
  283. Scroll(topline,leftedge,botline,rightedge,0)
  284.  
  285. *- for # of lines in box
  286. FOR m->kounter = 1 TO m->nbrlines
  287.   
  288.   *- redisplay the line
  289.   prnt(m->boxtop+m->kounter,m->leftedge,SUBST(Lines[m->kounter],m->lineoffset,m->linelength),m->standard)
  290.   
  291. NEXT
  292. RETURN ''
  293.  
  294.  
  295.  
  296. FUNCTION rf_scrlup
  297. PRIVATE seekto,position
  298.  
  299. *- not at end of file
  300. endof_file = .F.
  301.  
  302. *- but if at beginning of file, no going up
  303. IF Offset[1]=0
  304.   RETURN ''
  305. ENDIF
  306.  
  307. *- go up one line
  308. fgobak()
  309.  
  310. *- if we didn't move, return
  311. IF FSEEK(m->handle,0,1) = Offset[1]
  312.   RETURN ''
  313. ENDIF
  314.  
  315. *- insert a new element into position one of the arrays
  316. AINS(Lines,1)
  317. AINS(Offset,1)
  318.  
  319. *- put new offset and line into new array element
  320. Offset[1]= FSEEK(m->handle,0,1)
  321. position = Offset[1]
  322. Lines[1]=fgetline(m->handle)+SPACE(10)
  323.  
  324. *- go to beginning of line
  325. FSEEK(m->handle,m->position)
  326.  
  327. *- scroll the screen down one
  328. Scroll(m->topline,m->leftedge,m->botline,m->rightedge,-1)
  329.  
  330. *- draw the new line at top of the box
  331. prnt(m->topline,m->leftedge,SUBST(Lines[1],m->lineoffset,m->linelength),m->standard)
  332.  
  333. RETURN ''
  334.  
  335.  
  336.  
  337. FUNCTION rf_scrldn
  338.  
  339.  
  340. PARAM how_many
  341. PRIVATE kounter
  342.  
  343. *- first go to last line offset
  344. FSEEK(m->handle,Offset[m->nbrlines])
  345.  
  346. *- move up one line
  347. fgetline(m->handle)
  348.  
  349. *- for # of lines specified
  350. FOR m->kounter = 1 TO m->how_many
  351.   
  352.   *- if its the end of the file, don't continue
  353.   *- ( fgetline() will set this variable if EOF )
  354.   IF endof_file
  355.     EXIT
  356.   ENDIF
  357.   
  358.   *- delete element 1 in each array, thus shifting the other
  359.   *- elements down one
  360.   Adel(m->lines,1)
  361.   Adel(m->offset,1)
  362.   
  363.   *- get offset of next line
  364.   Offset[m->nbrlines]=FSEEK(m->handle,0,1)
  365.   
  366.   *- get next line
  367.   Lines[m->nbrlines]=fgetline(m->handle)+SPACE(10)
  368.   
  369.   *- scroll the screen up one line
  370.   Scroll(m->topline,m->leftedge,m->botline,m->rightedge,1)
  371.   
  372.   *- print the line
  373.   prnt(m->botline,m->leftedge,SUBST(Lines[m->nbrlines],m->lineoffset,m->linelength),m->standard)
  374.   
  375. NEXT
  376. RETURN ''
  377.  
  378.  
  379.  
  380. FUNCTION fgetline
  381.  
  382. PRIVATE return_line,chunk,bigchunk,oldoffset,at_chr13
  383.  
  384. return_line = ''
  385. bigchunk = ''
  386. oldoffset = FSEEK(m->handle,0,1)
  387. DO WHILE .T.
  388.   
  389.   *- read in a chunk of the file
  390.   chunk = ''
  391.   chunk = Freadstr(m->handle,100)
  392.   
  393.   *- if we didn't read anything in, guess we're at the EOF
  394.   IF LEN(m->chunk)=0
  395.     endof_file = .T.
  396.     
  397.     *-Wed  11-29-1989
  398.     IF !EMPTY(m->bigchunk)
  399.       return_line = m->bigchunk
  400.     ENDIF
  401.     *-Wed  11-29-1989
  402.     
  403.     EXIT
  404.   ENDIF
  405.   
  406.   *- add this chunk to the big chunk
  407.   bigchunk = m->bigchunk+m->chunk
  408.   
  409.   *- if we've got a CR , we've read in a line
  410.   *- otherwise we'll loop again and read in another chunk
  411.   IF AT(CHR(13),m->bigchunk) > 0
  412.     at_chr13 =AT(CHR(13),m->bigchunk)
  413.     
  414.     *- go back to beginning of line
  415.     FSEEK(m->handle,m->oldoffset)
  416.     
  417.     *- read in from here to next CR (-1)
  418.     return_line = Freadstr(m->handle,m->at_chr13-1)
  419.     
  420.     *- move the pointer 1 byte
  421.     FSEEK(m->handle,1,1)
  422.     
  423.     EXIT
  424.   ENDIF
  425. ENDDO
  426.  
  427. *- move the pointer 1 byte
  428. *- this should put us at the beginning of the next line
  429. FSEEK(m->handle,1,1)
  430.  
  431. *- return the contents of the line
  432. RETURN m->return_line
  433.  
  434.  
  435. FUNCTION fgobak
  436.  
  437. PRIVATE move_to,chunk,Buffer
  438.  
  439.  
  440. *- assume current position is beginning of a line
  441.  
  442.  
  443. *- save old offset
  444. oldoffset = FSEEK(m->handle,0,1)
  445. oldoffset = FSEEK(m->handle,MAX(0,m->oldoffset-3))
  446.  
  447. *- if we're at the beginning of file, return
  448. IF m->oldoffset = 0
  449.   RETURN ''
  450. ENDIF
  451.  
  452. *- determine where we're going to move to, but not beyond beginning if file
  453. move_to = MAX(m->oldoffset-160,0)
  454.  
  455. *- move backwards that many bytes
  456. move_to = FSEEK(m->handle,m->move_to)
  457.  
  458. *- now read in a line from here to the old offset
  459. chunk = Freadstr(m->handle,m->oldoffset-m->move_to)
  460.  
  461.  
  462. *- see if there's a CHR(10) in the lot
  463. IF AT(CHR(10),m->chunk) = 0
  464.   
  465.   *- if no chr(10)
  466.   DO WHILE .T.
  467.     
  468.     *- move back 1 - but not past beginning of file
  469.     move_to = MAX(m->move_to-1,0)
  470.     
  471.     *- if the offset to go to is less than 1, we're apparantly at the
  472.     *- beginning of the file, so just move the pointer to the beggining
  473.     *- of the file and exit
  474.     IF m->move_to < 1
  475.       FSEEK(m->handle,0)
  476.       EXIT
  477.     ENDIF
  478.     
  479.     *- move the pointer to the new position
  480.     FSEEK(m->handle,m->move_to)
  481.     
  482.     *- set up a buffer 1 byte long
  483.     Buffer = ' '
  484.     
  485.     *- read in a byte
  486.     Fread(m->handle,@Buffer,1)
  487.     IF m->buffer==CHR(10)
  488.       *- if its a chr(10), exit - otherwise loop back around
  489.       EXIT
  490.     ENDIF
  491.     
  492.   ENDDO
  493. ELSE
  494.   *- ok, so we've got one - or more
  495.   *- determine where it is
  496.   move_to = m->move_to+Rat(CHR(10),m->chunk)
  497.   
  498.   *- and move to that position
  499.   FSEEK(m->handle,m->move_to)
  500. ENDIF
  501.  
  502.  
  503.  
  504. FUNCTION fbot
  505. FSEEK(m->handle,0,2)
  506. RETURN ''
  507.  
  508. FUNCTION ftop
  509. FSEEK(m->handle,0)
  510. RETURN ''
  511.  
  512.  
  513. * History             11-29-1989  Added code to catch last line in
  514. *                     text file
  515. *                     01-17-1990 to popup using currently selected color
  516. *                     04-08-1990 removed calls to functions using
  517. *                     Clipper internals (S_STAT, PUSH_KEYS, POP_KEYS)
  518. *: EOF: S_FILER.PRG
  519.